home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr35
/
qwkblt12.zip
/
QWK-BLT.PPS
< prev
Wrap
Text File
|
1993-05-27
|
7KB
|
273 lines
;────── QWK-BLT.PPS ─────────────────────────────────────────────────────────
;
; Version 1.30
; May 26, 1994
; Copyright 1993, James Dean Jones
;
; Attach new main board bulletins to internally generated .QWK packets
;
; Sure would be nice if the PPLC supported random access files (hint)
; ... or ... if they do, someone PLEASE tell me
;
; 2/3 Board
; (217) 877-1138
; 16.8k Dual Standard
;
;────────────────────────────────────────────────────────────────────────────
;────── Variables ───────────────────────────────────────────────────────────
string cnames ; path of CNAMES file
string bltlst ; path of main board bulletin list
string cmdline ; command line to return to PCBoard
string token ; individual command
string bltpth ; path to bulletin
string nbltpth ; path of temporary copy of bulletin
string bltscan ; list of bulletins to scan
string line ; line of text from bulletin list file
string parseln ; line of text to parse
string buffer ; buffer for file copy
integer handle ; dos handle for bulletin list
integer isblt ; scan for bulletins?
integer addblt ; add bulletin to capture
integer acount ; count of attempted bulletins
integer bcount ; number of main board bulletins
integer lcount ; current position of seek
integer handsrc ; handle to source file
integer handdst ; handle to destination file
boolean ferror ; file error
boolean cfgthere ; found configuration file
boolean cont ; continue scanning?
integer ax ; registers for interrupts
integer bx
integer cx
integer dx
integer si
integer di
integer flags
integer ds
integer es
;────── Main Program ────────────────────────────────────────────────────────
let cmdline = ""
let isblt = 0
let acount = 1
let lcount = 1
let token = gettoken()
while (token != "") do
if (left(upper(token),1) = "B") then
let isblt = or(isblt,1)
else
let cmdline = cmdline + token
endif
if (left(upper(token),1) = "D") let isblt = or(isblt,2)
let token = gettoken()
endwhile
if (isblt != 3) goto alldone
;────── Bulletin Scan ───────────────────────────────────────────────────────
getuser
let cnames = readline(pcbdat(),31)
let bltlst = trim(readline(cnames,25)," ")
if (bltlst = "" | left(bltlst,1) = " ") goto alldone
if (!exist(bltlst)) goto alldone
if (exist(ppepath()+ppename()+".cfg")) then
let cfgthere = true
let bltscan = ""
let bltscan = readline(ppepath()+ppename()+".cfg",1)
else
let cfgthere = false
endif
let bcount = fileinf(bltlst,4) / 30
gosub openfile
let handle = regax()
if (ferror) goto alldone
dispstr "@X0FScanning Bulletins "
if (cfgthere) then
while (acount <= len(bltscan) & acount <= bcount) do
if (mid(bltscan,acount,1)!="Y") goto nextcfgblt
if (lcount != acount - 1) gosub seek
dispstr "."
gosub readdata
gosub handleblt
:nextcfgblt
inc acount
endwhile
else
while (acount <= bcount) do
if (and(acount,1)=1) dispstr "."
gosub readdata
gosub handleblt
:nextblt
inc acount
endwhile
endif
gosub closefile
dispstr chr(13)
goto alldone
;────── OpenFile ────────────────────────────────────────────────────────────
:OpenFile
varseg bltlst,ds
varoff bltlst,dx
let ax = 3d20h
dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
let handle = regax()
let ferror = regcf()
return
;────── ReadData ────────────────────────────────────────────────────────────
:ReadData
let parseln = " " ; 30 spaces
let bx = handle
let ax = 3f00h
let cx = len(parseln)
varseg parseln,ds
varoff parseln,dx
dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
ferror = regcf()
if (ferror | regax() = 0) let parseln = ""
let lcount = acount
return
;────── Seek ────────────────────────────────────────────────────────────────
:Seek
let bx = handle
let ax = 4200h
let dx = (30 * (acount - 1)) % 1000h
let cx = (30 * (acount - 1)) / 1000h
dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
ferror = regcf()
return
;────── CloseFile ───────────────────────────────────────────────────────────
:CloseFile
let bx = handle
let ax = 3e00h
dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
let ferror = regcf()
return
;────── UpdateDisp ──────────────────────────────────────────────────────────
:UpdateDisp
inc acount
if (and(acount,1)=1) dispstr "."
return
;────── HandleBlt ───────────────────────────────────────────────────────────
:HandleBlt
let bltpth = trim(parseln," ")
if (parseln = "") goto nextblt
if (!(exist(bltpth))) goto nextblt
if (fileinf(bltpth,4)=0) goto nextblt
let addblt = 0
if (fileinf(bltpth,2) >= u_ldate()) let addblt = or(addblt,1)
if (fileinf(bltpth,3) > u_ltime()) let addblt = or(addblt,2)
if (addblt = 3) then
let nbltpth = temppath()+fileinf(bltpth,8)+fileinf(bltpth,9)
gosub copyfile
endif
return
;────── CopyFile ────────────────────────────────────────────────────────────
:CopyFile
varseg bltpth,ds
varoff bltpth,dx
let ax = 3d20h
dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
if (regcf()) goto donecopy
let handsrc = regax()
varseg nbltpth,ds
varoff nbltpth,dx
let ax = 3c00h
let cx = 0000h
dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
if (regcf()) then
let bx = handsrc
dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
goto donecopy
endif
let handdst = regax()
let buffer = " " ; 32 spaces
let buffer = buffer + buffer
let buffer = buffer + buffer
let bx = handsrc
let cx = len(buffer)
varseg buffer,ds
varoff buffer,dx
let ax = 3f00h
dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
if (regcf() | regax() = 0) then
let cont = false
else
let cont = true
endif
while (cont) do
let bx = handdst
let cx = regax()
let ax = 4000h
dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
let bx = handsrc
let cx = len(buffer)
let ax = 3f00h
dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
if (regcf() | regax() = 0) let cont = false
endwhile
let bx = handdst
let ax = 3e00h
dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
let bx = handsrc
let ax = 3e00h
dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
:DoneCopy
return
;────── Finished ────────────────────────────────────────────────────────────
:alldone
kbdstuff "qwk " + cmdline + chr(13)
end